home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0004_MUSCNOTE.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  3KB  |  119 lines
  1. {
  2. > Does anyone have a "musical scale" of all the values With the Sound
  3. > Function? A friend is writing a "happy birthday" Program and wants to
  4. > get a list of all the notes without actually testing them (G)
  5.  
  6. { Here's a handy Unit that takes a lot of work out of playing music. }
  7. { I think it originally came from this echo.                         }
  8.  
  9. Unit Music;
  10. Interface
  11. Uses Crt;
  12. Const
  13.    e_note = 15;       { Eighth Note      }
  14.    q_note = 30;       { Quarter Note     }
  15.    h_note = 60;       { Half Note        }
  16.    dh_note = 90;      { Dotted Half Note }
  17.    w_note = 120;      { Whole Note       }
  18.    R = 0;             { Rest             }
  19.    C = 1;             { C                }
  20.    Cs = 2;            { C Sharp          }
  21.    Db = 2;            { D Flat           }
  22.    D = 3;             { D                }
  23.    Ds = 4;            { D Sharp          }
  24.    Eb = 4;            { E Flat           }
  25.    E = 5;             { Etc...           }
  26.    F = 6;
  27.    Fs = 7;
  28.    Gb = 7;
  29.    G = 8;
  30.    Gs = 9;
  31.    Ab = 9;
  32.    A = 10;
  33.    As = 11;
  34.    Bb = 11;
  35.    B = 12;
  36.  
  37. Procedure PlayTone(Octave : Byte; Note : Byte; Duration : Word);
  38. Procedure ToneOn(Octave   : Byte; Note     : Byte);
  39.  
  40. Implementation
  41.  
  42. Var
  43.    Oct_Val  : Array [0..8] Of Real;
  44.    Freq_Val : Array [C..B] Of Real;
  45.  
  46. Procedure Set_Frequencies;
  47. Var N : Byte;
  48. begin
  49.    Freq_Val[1] := 1;
  50.    For N := 2 To 12 Do
  51.       Freq_Val[N] := Freq_Val[N-1] * 1.0594630944;
  52.    Oct_Val[0] := 32.70319566;
  53.    For N := 1 To 8 Do
  54.       Oct_Val[N] := Oct_Val[N-1] * 2;
  55. end;
  56.  
  57. Procedure PlayTone(Octave : Byte;
  58.                    Note : Byte;
  59.                    Duration : Word);
  60. begin
  61.    If Note = R Then
  62.       NoSound
  63.    Else
  64.       Sound(Round(Oct_Val[Octave] * Freq_Val[Note]));
  65.    Delay(Duration*8);
  66.    NoSound;
  67. end;
  68.  
  69. Procedure ToneOn(Octave : Byte;
  70.                  Note   : Byte);
  71. begin
  72.    If Note = R Then NoSound
  73.    Else Sound(Round(Oct_Val[Octave] * Freq_Val[Note]));
  74.  
  75. end;
  76.  
  77. begin
  78. Set_Frequencies;
  79. NoSound;
  80. end.
  81.  
  82.  
  83. {
  84. Someone else: Here they are:
  85.  
  86. Const
  87.     C     =  2093;
  88.     C#    =  2217;
  89.     D     =  2349;
  90.     D#    =  2489;
  91.     E     =  2637;
  92.     F     =  2794;
  93.     F#    =  2960;
  94.     G     =  3136;
  95.     G#    =  3322;
  96.     A     =  3520;
  97.     A#    =  3729;
  98.     H     =  3951;
  99.  
  100. The next C is 2*2093, the C below is 2093 div 2 etc. pp.
  101. }
  102.  
  103. {
  104.  
  105. Here's an octive:
  106.   C = 262;
  107.   CSHARP = 277;
  108.   D = 294;
  109.   DSHARP = 311;
  110.   E = 330;
  111.   F = 349;
  112.   FSHARP = 370;
  113.   G = 392;
  114.   GSHARP = 415;
  115.   A = 440;
  116.   ASHARP = 466;
  117.   B = 494;
  118.   CC = 523;
  119. }